home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / text / print / ghostscript2_6_1.lha / wrfont.ps < prev    next >
Text File  |  1993-05-27  |  10KB  |  312 lines
  1. %    Copyright (C) 1991, 1993 Aladdin Enterprises.  All rights reserved.
  2. %
  3. % This file is part of Ghostscript.
  4. %
  5. % Ghostscript is distributed in the hope that it will be useful, but
  6. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility
  7. % to anyone for the consequences of using it or for whether it serves any
  8. % particular purpose or works at all, unless he says so in writing.  Refer
  9. % to the Ghostscript General Public License for full details.
  10. %
  11. % Everyone is granted permission to copy, modify and redistribute
  12. % Ghostscript, but only under the conditions described in the Ghostscript
  13. % General Public License.  A copy of this license is supposed to have been
  14. % given to you along with Ghostscript so you can know your rights and
  15. % responsibilities.  It should be in a file named COPYING.  Among other
  16. % things, the copyright notice and this notice must be preserved on all
  17. % copies.
  18.  
  19. % wrfont.ps
  20. % Write out a Type 1 font in readable, reloadable form.
  21. % Note that this does NOT work on protected fonts, such as Adobe fonts
  22. % (unless you have loaded unprot.ps first, in which case you may be
  23. % violating the Adobe license).
  24.  
  25. % ------ Options ------ %
  26.  
  27. % Define whether to write out the CharStrings in binary or in hex.
  28. % Binary takes less space on the file, but isn't guaranteed portable.
  29.    /binary false def
  30.  
  31. % Define whether to use binary token encodings for the CharStrings.
  32. % Binary tokens are smaller and load faster, but are a Level 2 feature.
  33. % If binary_tokens is true, encrypt_CharStrings is ignored (always true).
  34.    /binary_tokens false def
  35.  
  36. % Define whether to encrypt the CharStrings on the file.  (CharStrings
  37. % are always encrypted in memory.)  This increases loading time slightly,
  38. % but it makes the files compress much better for transport.
  39.    /encrypt_CharStrings true def
  40.  
  41. % ------ Output utilities ------ %
  42.  
  43. % By convention, the output file is named psfile.
  44.  
  45. % Define some utilities for writing the output file.
  46.    /wtstring 100 string def
  47.    /wb {psfile exch write} bind def
  48.    /wnb {/wb load repeat} bind def
  49.    /ws {psfile exch writestring} bind def
  50.    /wl {ws (\n) ws} bind def
  51.    /wt {wtstring cvs ws ( ) ws} bind def
  52.    /wd        % Write a dictionary.
  53.     { dup length wt (dict dup begin) wl { we } forall
  54.       (end) ws
  55.     } bind def
  56.    /wld        % Write a large dictionary more efficiently.
  57.            % Ignore the readonly attributes.
  58.     { dup length wt (dict dup begin) wl
  59.       0 exch
  60.        { exch wo wo () wl
  61.      1 add dup 200 eq
  62.       { wo ({def} repeat) wl 0 }
  63.      if
  64.        }
  65.       forall
  66.       dup 0 ne
  67.        { wo ({def} repeat) wl }
  68.        { pop }
  69.       ifelse
  70.       (end) ws
  71.     } bind def
  72.    /we        % Write a dictionary entry.
  73.     { exch wo wo /def cvx wo (\n) ws
  74.     } bind def
  75.    /wcs        % Write a CharString (or Subrs entry)
  76.     { dup length string copy
  77.       binary_tokens
  78.        { % Suppress recognizing the readonly status of the string.
  79.          wo
  80.        }
  81.        { encrypt_CharStrings not { 4330 exch dup .type1decrypt exch pop } if
  82.          readonly dup length wo ( ) ws readproc ws wx
  83.        }
  84.       ifelse
  85.     } bind def
  86.  
  87. % Construct the inversion of the system name table.
  88.    /SystemNames where
  89.     { pop /snit 256 dict def
  90.       0 1 255
  91.        { dup SystemNames exch get
  92.          dup null ne { exch snit 3 1 roll put } { pop pop } ifelse
  93.        }
  94.       for
  95.     }
  96.     { /snit 1 dict def
  97.     }
  98.    ifelse
  99.  
  100. % Write an object, using binary tokens if requested and possible.
  101.    /woa        % write in ascii
  102.     { psfile exch write==only
  103.     } bind def
  104.     % Lookup table for ASCII output.
  105.    /intbytes    % int nbytes -> byte*
  106.     { exch { dup 255 and exch -8 bitshift } repeat pop
  107.     } bind def
  108.    /wotta 8 dict dup begin
  109.     { /booleantype /integertype /nulltype /realtype }
  110.     { { ( ) ws woa } def }
  111.    forall
  112.      /nametype
  113.       { dup xcheck { ( ) ws } if woa
  114.       } bind def
  115.     { /arraytype /packedarraytype /stringtype }
  116.     { { dup woa wop } def }
  117.    forall
  118.    end def
  119.     % Lookup table for binary output.
  120.    /wottb 8 dict dup begin
  121.    wotta currentdict copy pop
  122.      /integertype
  123.       { dup dup 127 le exch -128 ge and
  124.          { 136 wb 255 and wb
  125.      }
  126.      { ( ) ws woa
  127.      }
  128.     ifelse
  129.       } bind def
  130.      /nametype
  131.       { dup snit exch known
  132.          { dup xcheck { 146 } { 145 } ifelse wb
  133.        snit exch get wb
  134.      }
  135.      { wotta /nametype get exec
  136.      }
  137.     ifelse
  138.       } bind def
  139.      /stringtype
  140.       { dup dup length dup 255 le { 142 2 } { 2 intbytes 143 3 } ifelse wnb
  141.         ws wop
  142.       } bind def
  143.    end def
  144.    /wop        % Write object protection
  145.      { wcheck not { /readonly cvx wo } if
  146.      } bind def
  147.    /wo        % Write an object.
  148.      { dup type binary_tokens { wottb } { wotta } ifelse
  149.        exch get exec
  150.      } bind def
  151.  
  152. % Write a hex string for Subrs or CharStrings.
  153.    /wx        % string ->
  154.     { binary
  155.        { ws
  156.        }
  157.        { % Some systems choke on very long lines, so
  158.      % we break up the hexstring into chunks of 50 characters.
  159.       { dup length 25 le {exit} if
  160.         dup 0 25 getinterval psfile exch writehexstring (\n) ws
  161.         dup length 25 sub 25 exch getinterval
  162.       } loop
  163.      psfile exch writehexstring
  164.        } ifelse
  165.     } bind def
  166.  
  167. % ------ The main program ------ %
  168.  
  169. % Define the dictionary of actions for special entries in the dictionaries.
  170. % We lump the font and the Private dictionary together, because
  171. % the set of keys doesn't overlap.
  172. [/CharStrings /Encoding /FID /FontInfo /Metrics /Private /Subrs]
  173. dup length dict begin
  174.  { null cvx def } forall
  175. currentdict end /specialkeys exch def
  176.  
  177. % Define the procedures for the Private dictionary.
  178. % These must be defined without `bind',
  179. % for the sake of the DISKFONTS feature.
  180. 4 dict begin
  181.  /-! {string currentfile exch readhexstring pop} def
  182.  /-| {string currentfile exch readstring pop} def
  183.  /|- {readonly def} def
  184.  /| {readonly put} def
  185. currentdict end /encrypted_procs exch def
  186. 4 dict begin
  187.  /-! {string currentfile exch readhexstring pop
  188.    4330 exch dup .type1encrypt exch pop} def
  189.  /-| {string currentfile exch readstring pop
  190.    4330 exch dup .type1encrypt exch pop} def
  191.  /|- {readonly def} def
  192.  /| {readonly put} def
  193. currentdict end /unencrypted_procs exch def
  194.  
  195. % Construct an inverse dictionary of encodings.
  196. 4 dict begin
  197.  StandardEncoding /StandardEncoding def
  198.  ISOLatin1Encoding /ISOLatin1Encoding def
  199.  SymbolEncoding /SymbolEncoding def
  200.  DingbatsEncoding /DingbatsEncoding def
  201. currentdict end /encodingnames exch def
  202.  
  203. /writefont        % psfile -> [writes the current font]
  204.  { /psfile exch def
  205.    /Font currentfont def
  206.    /readproc binary { (-| ) } { (-! ) } ifelse def
  207.    /privateprocs
  208.      encrypt_CharStrings binary_tokens not and
  209.       { encrypted_procs } { unencrypted_procs } ifelse
  210.      def
  211.    (%!FontType1-1.0: ) ws currentfont /FontName get wt (000.000) wl
  212.  
  213. % Turn on binary tokens if relevant.
  214.    binary_tokens { (currentobjectformat 1 setobjectformat) wl } if
  215.  
  216. % If the file has a UniqueID, write out a check against loading it twice.
  217.    Font /UniqueID known
  218.     { ({} FontDirectory) ws Font /FontName get dup wo ( known) wl
  219.       ( {) ws wo ( findfont dup /UniqueID known) wl
  220.       (    { dup /UniqueID get) ws Font /UniqueID get wo ( eq exch /FontType get 1 eq and }) wl
  221.       (    { pop false } ifelse) wl
  222.       (    { pop save /restore load } if) wl
  223.       ( } if) wl
  224.     }
  225.    if
  226.  
  227. % Write out the creation of the font dictionary and FontInfo.
  228.    Font length 1 add wt (dict begin) wl        % +1 for FontFile
  229.    Font begin
  230.    (/FontInfo ) ws FontInfo wd ( readonly def) wl
  231.  
  232. % Write out the other fixed entries in the font dictionary.
  233.    Font
  234.     { 1 index specialkeys exch known
  235.        { pop pop } { we } ifelse
  236.     } forall
  237.    /Encoding
  238.    encodingnames Encoding known
  239.     { encodingnames Encoding get cvx }
  240.     { Encoding }
  241.    ifelse we
  242.  
  243. % Write out the Metrics, if any.
  244.    Font /Metrics known
  245.     { (/Metrics ) ws Metrics wld ( readonly def) wl
  246.     }
  247.    if
  248.  
  249. % Close the font dictionary.
  250.    (currentdict end) wl
  251.  
  252. % The rest of the file could be in eexec form, but we don't see any point
  253. % in doing this, because we aren't attempting to conceal it from anyone.
  254.  
  255. % Create and initialize the Private dictionary.
  256.    Private dup length privateprocs length add dict copy begin
  257.    privateprocs { readonly def } forall
  258.    (dup /Private ) ws currentdict length 1 add wt (dict dup begin) wl
  259.    currentdict
  260.     { 1 index specialkeys exch known
  261.        { pop pop } { we } ifelse
  262.     } forall
  263.  
  264. % Write the Subrs entries, if any.
  265.    currentdict /Subrs known
  266.     { (/Subrs ) ws Subrs length wt (array) wl
  267.       0 1 Subrs length 1 sub
  268.        { dup Subrs exch get dup null ne
  269.       { /dup cvx wo exch wo wcs ( |) wl }
  270.       { pop pop }
  271.      ifelse
  272.        } for
  273.       (readonly def) wl
  274.     }
  275.    if
  276.  
  277. % Write the CharStrings entries.
  278.    (2 index /CharStrings ) ws
  279.    CharStrings length wt (dict dup begin) wl
  280.    CharStrings
  281.     { exch wo wcs ( |-) wl
  282.     } forall
  283.  
  284. % Wrap up the private part of the font.
  285.    (end) wl        % CharStrings
  286.    (end) wl        % Private
  287.    end            % Private
  288.    (readonly put) wl    % CharStrings in font
  289.    (readonly put) wl    % Private in font
  290.    end            % Font
  291.  
  292. % Terminate the output.
  293.    (dup /FontName get exch definefont pop) wl
  294.    Font /UniqueID known { (exec) wl } if
  295.    binary_tokens { (setobjectformat) wl } if
  296.  
  297.  } bind def
  298.  
  299. % ------ Other utilities ------ %
  300.  
  301. % Prune garbage characters and OtherSubrs out of the current font,
  302. % if the relevant dictionaries are writable.
  303. /prunefont
  304.  { currentfont /CharStrings get wcheck
  305.     { currentfont /CharStrings get dup [ exch
  306.        { pop dup (S????00?) .stringmatch not { pop } if
  307.        } forall
  308.       ] { 2 copy undef pop } forall pop
  309.     }
  310.    if
  311.  } bind def
  312.